home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MacHack 1997
/
MacHack 1997.toast
/
Hacks
/
Hacks ’94
/
[√] Distribution Restricted!
/
Christian Ruse
/
Fourier Paper + Apps
/
nih-image154_source.sea
/
V1.54 Source
/
Math.p
< prev
next >
Wrap
Text File
|
1994-01-27
|
25KB
|
1,000 lines
unit Math;
interface
uses
QuickDraw, Palettes, PrintTraps, globals, Utilities, Graphics, Camera, Filters;
procedure SetPasteMode (item: integer);
procedure DoMouseDownInPasteControl (loc: point);
procedure ShowPasteControl;
procedure DrawPasteControl;
procedure DoArithmetic (MenuItem: integer; constant: extended);
procedure DoMath (Src1PicNum, Src2PicNum: integer; result: str255);
procedure DoPasteMath;
procedure DoImageMath;
implementation
const
Src1Item = 7;
Src2Item = 8;
OpItem = 9;
procedure DoPasteMath;
const
PixelsPerUpdate = 15000;
var
nrows, ncols, hSrcStart, vSrcStart, hDstStart, vDstStart: integer;
SaveInfo: InfoPtr;
h, v, vDst, PixelCount, offset: integer;
Src, Dst: LineType;
tmp, range, min, max, StartTicks: LongInt;
x, xmax, xmin, xrange, xscale: extended;
begin
if TooWide then
exit(DoPasteMath);
ShowWatch;
OpPending := false;
WhatToUndo := UndoPaste;
KillRoi;
with info^.RoiRect do begin
ncols := right - left;
nrows := bottom - top;
hDstStart := left;
vDstStart := top;
end;
with ClipBufInfo^.RoiRect do begin
hSrcStart := left;
vSrcStart := top;
end;
if hDstStart < 0 then begin
offset := -hDstStart;
hDstStart := 0;
hSrcStart := hSrcStart + offset;
ncols := ncols - offset;
end;
if vDstStart < 0 then begin
offset := -vDstStart;
vDstStart := 0;
vSrcStart := vSrcStart + offset;
nrows := nrows - offset;
end;
with info^.PicRect do begin
if hDstStart + ncols > right then
ncols := right - hDstStart;
if vDstStart + nrows > bottom then
nrows := bottom - vDstStart;
end;
SaveInfo := info;
vDst := vDstStart;
min := 999999;
max := -999999;
xmin := 999999.0;
xmax := -999999.0;
StartTicks := TickCount;
{First pass to find result range}
if ScaleArithmetic then begin
for v := vSrcStart to vSrcStart + nRows - 1 do begin
Info := ClipBufInfo;
GetLine(hSrcStart, v, nCols, Src);
Info := SaveInfo;
GetLine(hDstStart, vDst, nCols, Dst);
case CurrentOp of
AddOp: begin
for h := 0 to nCols - 1 do begin
tmp := Src[h] + Dst[h];
if tmp > max then
max := tmp;
if tmp < Min then
min := tmp;
end;
end;
SubtractOp: begin
for h := 0 to nCols - 1 do begin
tmp := Dst[h] - Src[h];
if tmp > max then
max := tmp;
if tmp < Min then
min := tmp;
end;
end;
MultiplyOp: begin
for h := 0 to nCols - 1 do begin
tmp := LongInt(Dst[h]) * Src[h];
if tmp > max then
max := tmp;
if tmp < min then
min := tmp;
end;
end;
DivideOp: begin
for h := 0 to nCols - 1 do begin
tmp := Src[h];
if tmp = 0 then
tmp := 1;
x := Dst[h] / tmp;
if x > xmax then begin
xmax := x;
end;
if x < xmin then
xmin := x;
end;
end;
end;
vDst := vDst + 1;
end;
vDst := vDstStart;
if CurrentOp = DivideOp then begin
xrange := xmax - xmin;
if xrange <> 0.0 then
xscale := 256.0 / xrange
else
xscale := 1;
end
else
range := max - min;
end; {if ScaleArithmetic=true}
PixelCount := 0;
{Second pass to do arithmetic and scaling}
for v := vSrcStart to vSrcStart + nRows - 1 do begin
Info := ClipBufInfo;
GetLine(hSrcStart, v, nCols, Src);
Info := SaveInfo;
GetLine(hDstStart, vDst, nCols, Dst);
case CurrentOp of
AddOp:
if ScaleArithmetic then
for h := 0 to nCols - 1 do begin
tmp := Dst[h] + Src[h] - min;
if range <> 0 then
tmp := tmp * 256 div range
else
tmp := BackgroundIndex;
if tmp > 255 then
dst[h] := 255
else
dst[h] := tmp;
end
else
for h := 0 to nCols - 1 do begin
tmp := Dst[h] + Src[h];
if tmp > 255 then
dst[h] := 255
else
dst[h] := tmp;
end;
SubtractOp:
if ScaleArithmetic then
for h := 0 to nCols - 1 do begin
tmp := Dst[h] - Src[h] - min;
if range <> 0 then
tmp := tmp * 256 div range
else
tmp := BackgroundIndex;
if tmp > 255 then
dst[h] := 255
else
dst[h] := tmp;
end
else
for h := 0 to nCols - 1 do begin
tmp := Dst[h] - Src[h];
if tmp < 0 then
dst[h] := 0
else
dst[h] := tmp;
end;
MultiplyOp:
if ScaleArithmetic then
for h := 0 to nCols - 1 do begin
tmp := LongInt(Dst[h]) * Src[h] - min;
if range <> 0 then
tmp := tmp * 256 div range
else
tmp := BackgroundIndex;
if tmp > 255 then
dst[h] := 255
else
dst[h] := tmp;
end
else
for h := 0 to nCols - 1 do begin
tmp := LongInt(Dst[h]) * Src[h];
if tmp > 255 then
dst[h] := 255
else
dst[h] := tmp;
end;
DivideOp:
if ScaleArithmetic then
for h := 0 to nCols - 1 do begin
tmp := Src[h];
if tmp = 0 then
tmp := 1;
x := Dst[h] / tmp - xmin;
if xrange <> 0.0 then
tmp := trunc(x * xscale)
else
tmp := BackgroundIndex;
if tmp > 255 then
tmp := 255;
if tmp < 0 then
tmp := 0;
dst[h] := tmp;
end
else
for h := 0 to nCols - 1 do begin
tmp := Src[h];
if tmp = 0 then
tmp := 1;
dst[h] := Dst[h] div tmp;
end;
end;
PutLine(hDstStart, vDst, nCols, Dst);
vDst := vDst + 1;
PixelCount := PixelCount + ncols;
if PixelCount > PixelsPerUpdate then begin
UpdateScreen(info^.RoiRect);
if CommandPeriod then begin
UpdateScreen(info^.RoiRect);
beep;
exit(DoPasteMath)
end;
PixelCount := 0;
end;
end;
with info^ do begin
ShowTime(StartTicks, RoiRect, '');
UpdateScreen(RoiRect);
end;
end;
procedure SetPasteMode (item: integer);
var
SavePort: GrafPtr;
BlendColor: rgbColor;
begin
if not macro then begin
SetForegroundColor(BlackIndex);
SetBackGroundColor(WhiteIndex);
end;
case Item of
CopyModeItem:
PasteTransferMode := SrcCopy;
AndItem:
PasteTransferMode := NotSrcBic; {And}
OrItem:
PasteTransferMode := SrcOr;
XorItem:
PasteTransferMode := SrcXor;
ReplaceItem:
PasteTransferMode := Transparent;
BlendItem: begin
GetPort(SavePort);
with BlendColor do begin
red := 32767;
blue := 32767;
green := 32767;
end;
SetPort(GrafPtr(info^.osPort));
OpColor(BlendColor);
SetPort(SavePort);
PasteTransferMode := Blend;
end;
otherwise
end; {case}
end;
function GetTransferModeItem: integer;
begin
case PasteTransferMode of
SrcCopy:
GetTransferModeItem := CopyModeItem;
NotSrcBic:
GetTransferModeItem := AndItem;
SrcOr:
GetTransferModeItem := OrItem;
SrcXor:
GetTransferModeItem := XorItem;
Transparent:
GetTransferModeItem := ReplaceItem;
Blend:
GetTransferModeItem := BlendItem;
end;
end;
procedure DrawPasteControl;
const
bWidth = 64;
bHeight = 14;
vinc = 18;
bhloc = 114;
bvloc = 6;
var
tPort: GrafPtr;
i, hloc, vloc, item: integer;
tType: pcItemType;
tRect, TriangleRect: rect;
ItemStr: str255;
begin
GetPort(tPort);
SetPort(PasteControl);
with PcItem[1] do begin
SetRect(r, 15, 22, 95, 40);
itype := pcPopupMenu;
str := 'Transfer Mode';
end;
with pcItem[2] do begin
SetRect(r, 88, 50, 100, 62);
itype := pcCheckBox;
str := 'Scale Math';
end;
with pcItem[3] do begin
SetRect(r, 88, 65, 100, 77);
itype := pcCheckBox;
str := 'Live Paste';
end;
hloc := bhloc;
vloc := bvloc;
tType := pcButton;
with pcItem[4] do begin
SetRect(r, hloc, vloc, hloc + bWidth, vloc + bHeight);
itype := tType;
str := 'Add';
end;
vloc := vloc + vinc;
with pcItem[5] do begin
SetRect(r, hloc, vloc, hloc + bWidth, vloc + bHeight);
itype := tType;
str := 'Subtract';
end;
vloc := vloc + vinc;
with pcItem[6] do begin
SetRect(r, hloc, vloc, hloc + bWidth, vloc + bHeight);
itype := tType;
str := 'Multiply';
end;
vloc := vloc + vinc;
with pcItem[7] do begin
SetRect(r, hloc, vloc, hloc + bWidth, vloc + bHeight);
itype := tType;
str := 'Divide';
end;
TextFont(SystemFont);
TextSize(12);
for i := 1 to npcItems do
with pcItem[i] do
case iType of
pcPopupMenu:
with r do begin
MoveTo(r.left - 10, r.top - 4);
DrawString(str);
DrawDropBox(r);
item := GetTransferModeItem;
GetItem(TransferModeMenuH, item, ItemStr);
MoveTo(left + 13, bottom - 5);
DrawString(ItemStr);
end;
pcCheckBox:
with r do begin
MoveTo(left - StringWidth(str) - 4, bottom - 2);
DrawString(str);
EraseRect(r);
FrameRect(r);
if ((i = 2) and ScaleArithmetic) or ((i = 3) and LivePasteMode) then begin
MoveTo(left, top);
LineTo(right - 1, bottom - 1);
MoveTo(left, bottom - 1);
LineTo(right - 1, top);
end;
end;
pcButton: begin
FrameRoundRect(r, 6, 6);
with r do
MoveTo(left + ((right - left) - StringWidth(str)) div 2, bottom - 3);
DrawString(str);
end;
end; {case}
SetPort(tPort);
end;
procedure DoMouseDownInPasteControl; {(loc:point)}
var
nItem, i, MenuItem: integer;
tr: rect;
begin
if not (OpPending and (CurrentOp = PasteOp)) then begin
PutMessage('Paste Control is only available during paste operations.');
exit(DoMouseDownInPasteControl);
end;
SetPort(PasteControl);
GlobalToLocal(loc);
nItem := 0;
for i := 1 to npcItems do
if PtInRect(loc, pcItem[i].r) then
nitem := i;
if nItem > 0 then begin
case pcItem[nItem].itype of
pcPopUpMenu:
with pcItem[1].r do begin
MenuItem := PopUpMenu(TransferModeMenuH, left, top, GetTransferModeItem);
SetPasteMode(MenuItem);
end;
pcCheckBox: begin
tr := pcItem[nItem].r;
InsetRect(tr, 1, 1);
FrameRect(tr);
if nitem = 2 then
ScaleArithmetic := not ScaleArithmetic;
if nitem = 3 then begin
LivePasteMode := not LivePasteMode;
if LivePasteMode then begin
ExternalTrigger := false;
UpdateVideoControl
end;
end;
end;
pcButton: begin
InvertRoundRect(pcItem[nitem].r, 6, 6);
while Button and (nitem > 0) do begin
GetMouse(loc);
if not PtInRect(loc, pcItem[nitem].r) then begin
InvertRoundRect(pcItem[nitem].r, 6, 6);
nItem := 0;
end;
end;
end;
end; {case}
repeat
until not button;
if nItem > 0 then
with pcItem[nitem] do begin
case itype of
pcPopupMenu:
;
pcCheckBox: begin
end;
pcButton: begin
InvertRoundRect(pcItem[nitem].r, 6, 6);
if info^.RoiType = RectRoi then begin
case nitem of
4:
CurrentOp := AddOp;
5:
CurrentOp := SubtractOp;
6:
CurrentOp := MultiplyOp;
7:
CurrentOp := DivideOp;
end;
DoPasteMath;
end; {if}
end; {pcButton}
end; {case}
end; {with}
end; {if nitem>0}
if LivePasteMode and ((WhatsOnClip <> CameraPic) or ((FrameGrabber <> QuickCapture) and (FrameGrabber <> ScionLG3))) then begin
PutMessage('"Live Paste" requires that a rectangular selection be first copied from the Camera window to the Clipboard.');
LivePasteMode := false;
end;
if LivePasteMode and (info^.PictureType = FrameGrabberType) then begin
PutMessage('Live pasting into the Camera window is not supported.');
LivePasteMode := false;
end;
DrawPasteControl;
end;
procedure ShowPasteControl;
var
tPort: GrafPtr;
trect: rect;
wp: ^WindowPtr;
begin
SetRect(trect, PasteControlLeft, PasteControlTop, PasteControlLeft + pcwidth, PasteControlTop + pcheight);
PasteControl := NewWindow(nil, trect, 'Paste Control', true, rDocProc, nil, true, 0);
WindowPeek(PasteControl)^.WindowKind := PasteControlKind;
wp := pointer(GhostWindow);
wp^ := PasteControl;
PasteTransferMode := SrcCopy;
LivePasteMode := false;
end;
procedure DoArithmetic (MenuItem: integer; constant: extended);
var
table: LookupTable;
i: integer;
tmp: LongInt;
LogScale: extended;
Canceled: boolean;
begin
canceled := false;
if not macro then
case menuItem of
AddItem:
constant := GetReal('Constant to add:', 25, Canceled);
SubtractItem:
constant := GetReal('Constant to subtract:', 25, Canceled);
MultiplyItem: begin
constant := GetReal('Constant to multiply by:', 1.25, Canceled);
if constant < 0.0 then begin
PutMessage('Constant must be positive.');
exit(DoArithmetic);
end;
end;
DivideItem: begin
constant := GetReal('Constant to divide by:', 1.25, Canceled);
if constant <= 0.0 then begin
PutMessage('Constant must be nonzero and positive.');
exit(DoArithmetic);
end;
end;
LogItem: begin
constant := 0.0;
LogScale := 255.0 / ln(255.0);
end;
end; {case}
if Canceled then
exit(DoArithmetic);
for i := 0 to 255 do begin
case MenuItem of
AddItem:
tmp := round(i + constant);
SubtractItem:
tmp := round(i - constant);
MultiplyItem:
tmp := round(i * constant);
DivideItem:
tmp := round(i / constant);
LogItem:
if i = 0 then
tmp := 0
else
tmp := round(ln(i) * LogScale);
end;
if tmp < 0 then
tmp := 0;
if tmp > 255 then
tmp := 255;
table[i] := tmp;
end;
ApplyTable(table);
end;
function GetInfoPtr (PicN: integer): InfoPtr;
{Converts a pic number or pid number to an Info ptr.}
var
i: integer;
begin
i := 0;
while (PicN < 0) and (i < nPics) do begin
i := i + 1;
if InfoPtr(WindowPeek(PicWindow[i])^.RefCon)^.pidNum = PicN then
PicN := i;
end;
if (PicN >= 1) or (PicN <= nPics) then
GetInfoPtr := pointer(WindowPeek(PicWindow[PicN])^.RefCon)
else
GetInfoPtr := nil;
end;
procedure DoMath (Src1PicNum, Src2PicNum: integer; result: str255);
const
PixelsPerUpdate = 5000;
var
nrows, ncols, hStart, vStart: integer;
Src1Info, Src2Info, SaveInfo: InfoPtr;
h, v, PixelCount: integer;
src1, src2, dst: LineType;
tmp, tmp1, tmp2, StartTicks, scale, ScaledGain: LongInt;
rtmp: real;
roi: rect;
DoScaling: boolean;
begin
if TooWide then
exit(DoMath);
Src1Info := GetInfoPtr(Src1PicNum);
Src2Info := GetInfoPtr(Src2PicNum);
if (Src1Info = nil) or (Src2Info = nil) then begin
PutMessage('Bad pic num or pid num.');
macro := false;
exit(DoMath);
end;
ShowWatch;
if Src1Info^.RoiShowing and (Src1Info^.RoiType = RectRoi) then
roi := Src1Info^.RoiRect
else if Src2Info^.RoiShowing and (Src2Info^.RoiType = RectRoi) then
roi := Src2Info^.RoiRect
else
roi := Src1Info^.PicRect;
if not SectRect(roi, Src1Info^.PicRect, roi) then begin
macro := false;
exit(DoMath);
end;
if not SectRect(roi, Src2Info^.PicRect, roi) then begin
macro := false;
exit(DoMath);
end;
with roi do begin
ncols := right - left;
nrows := bottom - top;
hStart := left;
vStart := top;
end;
if (ncols < 30) or (nrows < 1) then begin
PutMessage('Selection is too small.');
macro := false;
exit(DoMath);
end;
if not NewPicWindow(result, ncols, nrows) then
exit(DoMath);
SaveInfo := info;
StartTicks := TickCount;
PixelCount := 0;
scale := 10000;
ScaledGain := round(MathGain * scale);
DoScaling := (MathGain <> 1.0) or (MathOffset <> 0);
for v := vStart to vStart + nRows - 1 do begin
info := Src1Info;
GetLine(hStart, v, nCols, src1);
Info := Src2Info;
GetLine(hStart, v, nCols, src2);
case CurrentMathOp of
AddMath:
for h := 0 to nCols - 1 do begin
tmp := src1[h] + src2[h];
tmp := (tmp * ScaledGain) div scale + MathOffset;
if tmp > 255 then
tmp := 255;
if tmp < 0 then
tmp := 0;
dst[h] := tmp;
end;
SubMath:
for h := 0 to nCols - 1 do begin
tmp := src1[h] - src2[h];
tmp := (tmp * ScaledGain) div scale + MathOffset;
if tmp > 255 then
tmp := 255;
if tmp < 0 then
tmp := 0;
dst[h] := tmp;
end;
MulMath:
for h := 0 to nCols - 1 do begin
tmp := LongInt(src1[h]) * src2[h];
tmp := (tmp * ScaledGain) div scale + MathOffset;
if tmp > 255 then
tmp := 255;
if tmp < 0 then
tmp := 0;
dst[h] := tmp;
end;
DivMath:
for h := 0 to nCols - 1 do begin
rtmp := src1[h] / src2[h];
tmp := round(rtmp * MathGain) + MathOffset;
if tmp > 255 then
tmp := 255;
if tmp < 0 then
tmp := 0;
dst[h] := tmp;
end;
AndMath:
for h := 0 to nCols - 1 do begin
tmp := band(src1[h], src2[h]);
if DoScaling then begin
tmp := (tmp * ScaledGain) div scale + MathOffset;
if tmp > 255 then
tmp := 255;
if tmp < 0 then
tmp := 0;
end;
dst[h] := tmp;
end;
OrMath:
for h := 0 to nCols - 1 do begin
tmp := bor(src1[h], src2[h]);
if DoScaling then begin
tmp := (tmp * ScaledGain) div scale + MathOffset;
if tmp > 255 then
tmp := 255;
if tmp < 0 then
tmp := 0;
end;
dst[h] := tmp;
end;
XorMath:
for h := 0 to nCols - 1 do begin
tmp := bxor(src1[h], src2[h]);
if DoScaling then begin
tmp := (tmp * ScaledGain) div scale + MathOffset;
if tmp > 255 then
tmp := 255;
if tmp < 0 then
tmp := 0;
end;
dst[h] := tmp;
end;
MaxMath:
for h := 0 to nCols - 1 do begin
tmp1 := src1[h];
tmp2 := src2[h];
if tmp1 >= tmp2 then
tmp := tmp1
else
tmp := tmp2;
if DoScaling then begin
tmp := (tmp * ScaledGain) div scale + MathOffset;
if tmp > 255 then
tmp := 255;
if tmp < 0 then
tmp := 0;
end;
dst[h] := tmp;
end;
MinMath:
for h := 0 to nCols - 1 do begin
tmp1 := src1[h];
tmp2 := src2[h];
if tmp1 <= tmp2 then
tmp := tmp1
else
tmp := tmp2;
if DoScaling then begin
tmp := (tmp * ScaledGain) div scale + MathOffset;
if tmp > 255 then
tmp := 255;
if tmp < 0 then
tmp := 0;
end;
dst[h] := tmp;
end;
CopyMath:
for h := 0 to nCols - 1 do begin
tmp := src1[h];
if DoScaling then begin
tmp := (tmp * ScaledGain) div scale + MathOffset;
if tmp > 255 then
tmp := 255;
if tmp < 0 then
tmp := 0;
end;
dst[h] := tmp;
end;
end;
Info := SaveInfo;
PutLine(0, v - vstart, nCols, Dst);
PixelCount := PixelCount + ncols;
if PixelCount > PixelsPerUpdate then begin
UpdateScreen(info^.RoiRect);
if CommandPeriod then begin
UpdateScreen(info^.RoiRect);
beep;
macro := false;
exit(DoMath)
end;
PixelCount := 0;
end;
end;
with info^ do begin
ShowTime(StartTicks, RoiRect, '');
UpdateScreen(RoiRect);
Changes := true;
end;
end;
function ImageTitle (var PicNumber: integer): str255;
var
TempInfo: InfoPtr;
begin
if (PicNumber < 1) or (PicNumber > nPics) then
PicNumber := 1;
TempInfo := pointer(WindowPeek(PicWindow[PicNumber])^.RefCon);
ImageTitle := TempInfo^.title;
end;
procedure ImageMathUProc (d: DialogPtr; item: integer);
{User proc for Image Math dialog box}
var
str: str255;
VersInfo: str255;
r: rect;
begin
SetPort(d);
GetDItemRect(d, item, r);
DrawDropBox(r);
case item of
Src1Item:
DrawPopUpText(ImageTitle(MathSrc1), r);
Src2Item:
DrawPopUpText(ImageTitle(MathSrc2), r);
OpItem: begin
GetItem(ImageMathOpsMenuH, ord(CurrentMathOp) + 1, str);
DrawPopUpText(str, r);
end;
end;
end;
function PopUpImageList (r: rect; CurrentImage: integer): integer;
var
i: integer;
begin
for i := 1 to nPics do begin
AppendMenu(ImageListMenuH, ' ');
SetItem(ImageListMenuH, i, ImageTitle(i));
end;
PopUpImageList := PopUpMenu(ImageListMenuH, r.left, r.top, CurrentImage);
for i := 1 to nPics do
DelMenuItem(ImageListMenuH, 1);
end;
procedure DoImageMath;
const
ScaleItem = 10;
OffsetItem = 11;
ResultItem = 12;
var
d: DialogPtr;
item, i, MenuItem: integer;
r: rect;
str: str255;
ScaleOffEdited: boolean;
procedure ShowScaleAndOffset;
begin
SetDReal(d, ScaleItem, MathGain, 4);
SetDNum(d, OffsetItem, MathOffset);
end;
procedure ResetScaleOff;
begin
if not ScaleOffEdited then begin
MathGain := 1.0;
MathOffset := 0;
ShowScaleAndOffset;
end;
end;
begin
InitCursor;
ScaleOffEdited := false;
d := GetNewDialog(200, nil, pointer(-1));
SetUProc(d, Src1Item, @ImageMathUProc);
SetUProc(d, Src2Item, @ImageMathUProc);
SetUProc(d, OpItem, @ImageMathUProc);
ShowScaleAndOffset;
SetDString(d, ResultItem, MathResult);
if (MathSrc1 = 1) and (MathSrc2 = 1) then
MathSrc1 := info^.PicNum;
if MathSrc1 = MathSrc2 then begin
if MathSrc1 = info^.PicNum then begin
MathSrc2 := MathSrc2 + 1;
if MathSrc2 > nPics then
MathSrc2 := 1;
end
else
MathSrc2 := info^.PicNum;
end;
repeat
if item = Src1Item then begin
setport(d);
GetDItemRect(d, item, r);
MenuItem := PopUpImageList(r, MathSrc1);
DrawDropBox(r);
if MenuItem <> 0 then
MathSrc1 := MenuItem;
DrawPopUpText(ImageTitle(MathSrc1), r);
end;
if item = Src2Item then begin
setport(d);
GetDItemRect(d, item, r);
MenuItem := PopUpImageList(r, MathSrc2);
DrawDropBox(r);
if MenuItem <> 0 then
MathSrc2 := MenuItem;
DrawPopUpText(ImageTitle(MathSrc2), r);
end;
if item = OpItem then begin
setport(d);
GetDItemRect(d, item, r);
MenuItem := PopUpMenu(ImageMathOpsMenuH, r.left, r.top, ord(CurrentMathOp) + 1);
case MenuItem of
1: begin
CurrentMathOp := AddMath;
if not ScaleOffEdited then begin
MathGain := 0.5;
MathOffset := 0;
ShowScaleAndOffset;
end;
end;
2: begin
CurrentMathOp := SubMath;
if not ScaleOffEdited then begin
MathGain := 0.5;
MathOffset := 128;
ShowScaleAndOffset;
end;
end;
3: begin
CurrentMathOp := MulMath;
if not ScaleOffEdited then begin
MathGain := 1.0 / 255.0;
MathOffset := 0;
ShowScaleAndOffset;
end;
end;
4: begin
CurrentMathOp := DivMath;
if not ScaleOffEdited then begin
MathGain := 255.0;
MathOffset := 0;
ShowScaleAndOffset;
end;
end;
5: begin
CurrentMathOp := AndMath;
ResetScaleOff;
end;
6: begin
CurrentMathOp := OrMath;
ResetScaleOff;
end;
7: begin
CurrentMathOp := XorMath;
ResetScaleOff;
end;
8: begin
CurrentMathOp := MaxMath;
ResetScaleOff;
end;
9: begin
CurrentMathOp := MinMath;
ResetScaleOff;
end;
10: begin
CurrentMathOp := CopyMath;
ResetScaleOff;
end;
otherwise
end;
DrawDropBox(r);
GetItem(ImageMathOpsMenuH, ord(CurrentMathOp) + 1, str);
DrawPopUpText(str, r);
end;
if item = ScaleItem then begin
MathGain := GetDReal(d, ScaleItem);
ScaleOffEdited := true;
end;
if item = OffsetItem then begin
MathOffset := GetDNum(d, OffsetItem);
ScaleOffEdited := true;
end;
ModalDialog(nil, item);
until (item = ok) or (item = cancel);
MathResult := GetDString(d, ResultItem);
DisposDialog(d);
if item = cancel then
exit(DoImageMath);
DoMath(MathSrc1, MathSrc2, MathResult);
end;
end.